home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / dbase / lib19.zip / STRINGS.PRG < prev    next >
Text File  |  1992-08-31  |  44KB  |  1,214 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: STRINGS.PRG
  3. *-- Programmer: Ken Mayer (KENMAYER)
  4. *-- Date......: 08/31/1992
  5. *-- Notes.....: String manipulation routines -- These routines are all designed
  6. *--             to handle the processing of "Strings" (Character Strings).
  7. *--             They range from simple checking of the location of a string 
  8. *--             inside another, to reversing the contents of a string ... 
  9. *--             and lots more. See the file: README.TXT for details on use
  10. *--             of this (and the other) library file(s).
  11. *-------------------------------------------------------------------------------
  12.  
  13. FUNCTION Proper
  14. *-------------------------------------------------------------------------------
  15. *-- Programmer..: Clinton L. Warren (VBCES)
  16. *-- Date........: 07/10/1991
  17. *-- Notes.......: Returns cBaseStr converted to proper case.  Converts
  18. *--               "Mc", "Mac", and "'s" as special cases.  Inspired by
  19. *--               A-T's CCB Proper function.  cBaseStr isn't modified.
  20. *-- Written for.: dBASE IV, 1.1
  21. *-- Rev. History: 07/10/1991 1.0 - Original version (VBCES/CLW)
  22. *-- Calls.......: None
  23. *-- Called by...: Any
  24. *-- Usage.......: Proper(<cBaseStr>)
  25. *-- Example.....: Proper("mcdonald's") returns "McDonald's"
  26. *-- Returns.....: Propertized string (e.g. "Test String")
  27. *-- Parameters..: cBaseStr = String to be propertized
  28. *-------------------------------------------------------------------------------
  29.  
  30.     PARAMETERS cBaseStr
  31.     private nPos, cDeli, cWrkStr
  32.  
  33.     cWrkStr = lower(cBaseStr) + ' '             && space necessary for 's process
  34.  
  35.     nPos = at('mc', cWrkStr)                    && "Mc" handling
  36.     do while nPos # 0
  37.        cWrkStr = stuff(cWrkStr, nPos, 3, upper(substr(cWrkStr, nPos, 1)) ;
  38.                 + lower(substr(cWrkStr, nPos + 1, 1)) ;
  39.                 + upper(substr(cWrkStr, nPos + 2, 1)))
  40.         nPos = at('mc', cWrkStr)
  41.       enddo
  42.  
  43.     nPos = at('mac', cWrkStr)                    && "Mac" handling
  44.     do while nPos # 0
  45.        cWrkStr = stuff(cWrkStr, nPos, 4, upper(substr(cWrkStr, nPos, 1)) ;
  46.                                 + lower(substr(cWrkStr, nPos + 1, 2)) ;
  47.                                 + upper(substr(cWrkStr, nPos + 3, 1)))
  48.         nPos = at('mac', cWrkStr)
  49.     enddo
  50.  
  51.     cWrkStr = stuff(cWrkStr, 1, 1, upper(substr(cWrkStr, 1, 1)))
  52.     nPos = 2
  53.     cDeli = [ -.'"\/`]                           && standard delimiters
  54.  
  55.     do while nPos <= len(cWrkStr)                && 'routine' processing
  56.         if substr(cWrkStr,nPos-1,1) $ cDeli
  57.           cWrkStr = stuff(cWrkStr, nPos, 1, upper(substr(cWrkStr,nPos,1)))
  58.         endif
  59.         nPos = nPos + 1
  60.     enddo
  61.  
  62.     nPos = at("'S ", cWrkStr)                    && 's processing
  63.     do while nPos # 0
  64.         cWrkStr = stuff(cWrkStr, nPos, 2, lower(substr(cWrkStr, nPos, 2)))
  65.         nPos = at('mac', cWrkStr)
  66.     enddo
  67.  
  68. RETURN (cWrkStr)
  69. *-- EoF: Proper()
  70.  
  71. FUNCTION Justify
  72. *-------------------------------------------------------------------------------
  73. *-- Programmer..: Roland Bouchereau (Ashton-Tate)
  74. *-- Date........: 12/17/1991
  75. *-- Notes.......: Used to pad a field/string on the right, left or both,
  76. *--               justifying or centering it within the length specified.
  77. *--               If the length of the string passed is greater than
  78. *--               the size needed, the function will truncate it. 
  79. *--               Taken from Technotes, June 1990. Defaults to Left Justify
  80. *--               if invalid TYPE is passed ...
  81. *-- Written for.: dBASE IV, 1.0
  82. *-- Rev. History: Original function 06/15/1991/
  83. *--               12/17/1991 -- Modified into ONE function from three by
  84. *--               Ken Mayer, added a third parameter to handle that.
  85. *-- Calls.......: None
  86. *-- Called by...: Any
  87. *-- Usage.......: Justify(<cFld>,<nLength>,"<cType>")
  88. *-- Example.....: ?? Justify(Address,25,"R")
  89. *-- Returns.....: Padded/truncated field
  90. *-- Parameters..: cFld    =  Field/Memvar/Character String to justify
  91. *--               nLength =  Width to justify within
  92. *--               cType   =  Type of justification: L=Left, C=Center,R=Right
  93. *-------------------------------------------------------------------------------
  94.     
  95.     parameters cFld,nLength,cType
  96.     private cReturn
  97.     
  98.     cType = upper(cType)    && just making sure ...
  99.     if type("cFld")+type("nLength")+type("cType") $ "CNC,CFC"
  100.        *-- set a picture function of 'X's, with @I,@J or @B function
  101.         cReturn = transform(cFld,iif(cType="C","@I ",iif(cType="R","@J ","@B "));
  102.             +replicate("X",max(0,min(nLength,254))))
  103.     else
  104.         cReturn = ""
  105.     endif
  106.  
  107. RETURN cReturn
  108. *-- EoF: Justify()
  109.  
  110. FUNCTION Dots
  111. *-------------------------------------------------------------------------------
  112. *-- Programmer..: Ken Mayer (KENMAYER)
  113. *-- Date........: 12/17/1991
  114. *-- Notes.......: Based on ideas from Technotes, June, 1990 (see JUSTIFY() ),
  115. *--               this function should pad a field or memvar with dots to the
  116. *--               left, right or both sides. Note that if the field is too
  117. *--               large for the length passed (nLength) it will be truncated.
  118. *-- Written for.: dBASE IV, 1.1
  119. *-- Rev. History: None
  120. *-- Calls.......: ALLTRIM()            Function in PROC.PRG
  121. *-- Called by...: Any
  122. *-- Usage.......: Dots(<cFld>,<nLength>,"<cType>")
  123. *-- Example.....: ?? Dots(Address,25,"R")
  124. *-- Returns.....: Field/memvar with dot leader/trailer ...
  125. *-- Parameters..: cFld    =  Field/Memvar/Character String to justify
  126. *--               nLength =  Width to justify within
  127. *--               cType   =  Type of justification: L=Left, C=Center,R=Right
  128. *-------------------------------------------------------------------------------
  129.     
  130.     parameters cFld,nLength,cType
  131.     private cReturn, nVal, nMore
  132.     
  133.     if type("cFld")+type("nLength")+type("cType") $ "CNC,CFC"
  134.     
  135.         cType   = upper(cType)      && just to make sure ...
  136.         cReturn = AllTrim(cFld)     && trim this puppy on all sides
  137.         if len(cReturn) => nLength  && check length against parameter
  138.                                     && truncate if necessary
  139.             cReturn = substr(cReturn,1,nLength)
  140.         endif
  141.         
  142.         do case
  143.             case cType = "L"  && Left -- add trailing dots to field
  144.                 cReturn = cReturn + replicate(".",nLength-len(cReturn))
  145.             case cType = "R"  && Right -- add leading dots to field
  146.                 cReturn = replicate(".",nLength-len(cReturn))+cReturn
  147.             case cType = "C"  && Center -- add 'em to both sides ...
  148.                 nVal = int( (nLength - len(cReturn)) / 2)
  149.                 *-- here, we have to deal with fractions ...
  150.                 nMore = mod(nlength - len(cReturn), 2)
  151.                 *-- add dots on left, field, dots on right (add one if a fraction)
  152.                 cReturn = replicate(".",nVal)+cReturn+;
  153.                           replicate(".",nVal+iif(nMore>0,1,0))
  154.             otherwise         && invalid parameter ... return nothing
  155.                 cReturn = ""
  156.         endcase
  157.     else
  158.         cReturn = ""
  159.     endif
  160.  
  161. RETURN cReturn
  162. *-- EoF: Dots()
  163.  
  164. FUNCTION CutPaste
  165. *-------------------------------------------------------------------------------
  166. *-- Programmer..: Martin Leon (HMAN)
  167. *-- Date........: 03/05/1992
  168. *-- Notes.......: Used to do a cut and paste within a field/character string.
  169. *--               (Taken from an issue of Technotes, can't remember which)
  170. *--               This function will not allow you to overflow the field/char
  171. *--               string -- i.e., if the Paste part of the function would cause
  172. *--               the returned field to be longer than it started out, it will
  173. *--               not perform the cut/paste (STUFF()). For example, if your 
  174. *--               field were 15 characters, and you wanted to replace 5 of them
  175. *--               with a 10 character string:
  176. *--                      (CutPaste(field,"12345","1234567890"))
  177. *--               If this would cause the field returned to be longer than 15,
  178. *--               the function will return the original field.
  179. *-- Written for.: dBASE IV, 1.1
  180. *-- Rev. History: Original function 12/17/1991
  181. *--               03/05/1992 -- minor change to TRIM(cFLD) in the early
  182. *--               bits, solving a minor problem with phone numbers that
  183. *--               Dave Creek (DCREEK) discovered.
  184. *-- Calls.......: N